(GLOBAL (FUNCTIONS TRY-NEXT
 		   NOTE
 		   ADIEU
 		   AU-REVOIR
 		   INSTANCE
 		   GET-POSSIBILITIES
 		   SET-POSSIBILITIES
 		   GENERATE)
	(RESERVED *IGNORE
 		  *ITEM
 		  *NOTE
 		  *METHOD
 		  *GENERATOR
 		  *AU-REVOIR
 		  *BLOCK
 		  *POSSIBILITIES))

(DECLARE (SYMBOLS T)
	 (GENPREFIX \T)
	 (GENSYM (QUOTE T))
	 (SPECIAL TEM TEM1 TEM2 ALINK BVARS EXP CLINK FRAME* VAL)
	 (*FEXPR CERR INSTANCE PROPOSE /,)
	 (*LEXPR CSET VFRAME ACCESS CONTROL))

(DEFPROP ALINK (LAMBDA (L) (LIST (QUOTE CDADR) (CADR L))) MACRO)

(DEFPROP CLINK (LAMBDA (L) (LIST (QUOTE CDDDR) (CADR L))) MACRO)

(CDEFUN TRY-NEXT
	(POSSIBILITIES "OPTIONAL" (NOMORE NIL) (MESSAGE NIL))
        "AUX"
	(POS)
	(: TRY-NEXT)
	(GO (NEXT))
	(: EXIT)
	(RETURN (CEVAL NOMORE (ACCESS)))
	(: RETURN)
	(RETURN POS)
	(: *METHOD)
	(METGO)
	(: *GENERATOR)
	(GENGO)
	(: *AU-REVOIR)
	(REGO)
	(: *BLOCK)
	(TBLOCK))

(DEFPROP NEXT
	 (LAMBDA(L)
	  (PROG NIL
		(SETQ L (/, POSSIBILITIES))
		(COND
		 ((OR (ATOM L)
		      (NOT (EQ (CAAR L) (QUOTE *POSSIBILITIES))))
		  (CERR BAD POSSIBILITIES LIST)))
		(RETURN
		 (PROG (P)
		       (COND ((NULL (CDR L)) (RETURN (QUOTE EXIT))))
		       (UNBLOCK (CDR L))
 		  TN   (RPLACD L (CDDR L))
		       (COND
			((NULL (CDR L)) (RETURN (QUOTE EXIT)))
			((EQ (SETQ P (CADR L)) (QUOTE *IGNORE))
			 (GO TN))
			((ATOM P) (CSET (QUOTE POS) P)
				  (RETURN (QUOTE RETURN)))
			((EQ (CAR P) (QUOTE *ITEM))
			 (SETUP (CADDR P))
			 (CSET (QUOTE POS) (CADR P))
			 (RETURN (QUOTE RETURN)))
			((EQ (CAR P) (QUOTE *NOTE))
			 (SETUP (CADR P))
			 (CSET (QUOTE POS) P)
			 (RETURN (QUOTE RETURN)))
			((MEMQ (CAR P)
			       (QUOTE
				(*METHOD *GENERATOR
 					 *AU-REVOIR
 					 *BLOCK)))
			 (RETURN (CAR P)))
			(T (CSET (QUOTE POS) P)
			   (RETURN (QUOTE RETURN))))))))
 	 FEXPR)

(DEFPROP SETUP
	 (LAMBDA(ALIST)
	  (PROG NIL
		(SETQ TEM (ACCESS))
		(RETURN
		 (MAPC (QUOTE
			(LAMBDA(PAIR)
			 (CSET (CAR PAIR) (CADR PAIR) TEM)))
 		       ALIST))))
 	 EXPR)

(DEFPROP GENGO
	 (LAMBDA NIL
	  (PROG NIL
		(SETQ TEM (CDR (IVAL (QUOTE POSSIBILITIES) ALINK)))
		(SETQ BVARS (LIST (LIST (QUOTE NEXT) TEM)))
		(SETQ CLINK (FR (TAG (QUOTE TRY-NEXT))))
		(SETQ ALINK (ALINK CLINK))
		(SETQ TEM1 (CADAR TEM))
		(SETQ FRAME* NIL)
		(RPLACA TEM (LIST (QUOTE *BLOCK)))
		(RETURN
		 (DISPATCH TEM1 (QUOTE POPJ) NIL (QUOTE *TOP)))))
 	 EXPR)

(DEFPROP GENGO GENGO CINT)

(DEFPROP METGO
	 (LAMBDA NIL
	  (PROG NIL
		(SETQ TEM (CDR (IVAL (QUOTE POSSIBILITIES) ALINK)))
		(SETQ TEM1 (CADAR TEM))
		(SETQ BVARS
		      (NCONC (LIST (LIST (QUOTE NEXT) TEM)
				   (LIST (QUOTE *BODY) (TEXT TEM1))
				   (LIST
				    (QUOTE *CALLPAT)
				    (CADDDR (CDAR TEM)))
				   (LIST
				    (QUOTE *METHPAT)
				    (PATTERN TEM1))
				   (LIST
				    (QUOTE *CALLALIST)
				    (CADDDR (CAR TEM)))
				   (LIST
				    (QUOTE *METHALIST)
				    (CADDAR TEM)))
			     (CADDAR TEM)))
		(SETQ EXP (LIST TEM1 (CADDDR (CDAR TEM))))
		(SETQ FRAME* NIL)
		(SETQ CLINK (FR (TAG (QUOTE TRY-NEXT))))
		(SETQ ALINK (ALINK CLINK))
		(CLOSE)
		(RPLACA TEM (LIST (QUOTE *BLOCK)))
		(RETURN (QUOTE AUXB))))
 	 EXPR)

(DEFPROP METGO METGO CINT)
(DEFPROP REGO
	 (LAMBDA NIL
	  (PROG NIL
		(SETQ TEM (CDR (IVAL (QUOTE POSSIBILITIES) ALINK)))
		(SETQ VAL (IVAL (QUOTE MESSAGE) ALINK))
		(SETQ FRAME* (CADAR TEM))
		(SETCONTROL (VFRAME (QUOTE NEXT) (CAR TEM))
			    (TAG (QUOTE TRY-NEXT)))
		(CSET (QUOTE NEXT) TEM (CAR TEM))
		(RPLACA TEM (LIST (QUOTE *BLOCK)))
		(RETURN (RESTORE))))
 	 EXPR)

(DEFPROP REGO REGO CINT)

(CDEFUN TBLOCK
        NIL
	(NCONC (CADR POSSIBILITIES) (TAG (QUOTE TRY-NEXT)))
	(ALLOW NIL)
	(COND
	 ((@ . READY)
	  (CONTINUE
	   (@ PROG2
	      (ALLOW T)
	      (CAR READY)
	      (SETQ READY (CDR READY))))))
	(ALLOW T)
	(LISTEN (QUOTE ALL-BLOCKED-UP)))

(DEFPROP UNBLOCK
	 (LAMBDA(L)
	  (COND
	   ((EQ (CAAR L) (QUOTE *BLOCK))
	    (NCONC (GET (QUOTE READY) (QUOTE VALUE)) (CDAR L))
	    (RPLACA L (QUOTE *IGNORE)))))
 	 EXPR)

(DEFPROP NOTE
	 (LAMBDA N
	  (COND
	   ((= N 0) ((LAMBDA (P) (COND (P (ENTER P)))) (INSTANCE)) 0)
	   (T
	    (PROG (NEXT M)
		  (SETQ M 0)
		  (SETQ NEXT (CDR (VLOC (QUOTE NEXT))))
 	     LP   (COND ((> (SETQ M (ADD1 M)) N) (RETURN N)))
		  (RPLACD (CAR NEXT) (CONS (ARG M) (CDAR NEXT)))
		  (RPLACA NEXT (CDAR NEXT))
		  (GO LP)))))
 	 EXPR)

(CDEFUN ADIEU ("REST" L) (PROPOSE) (DISMISS (VFRAME (QUOTE NEXT))))

(CDEFUN AU-REVOIR
	("REST" L)
	(PROPOSE)
	(ENTER (CONS (QUOTE *AU-REVOIR) (CDR (CONTROL))))
	(DISMISS (VFRAME (QUOTE NEXT))))

(DEFPROP ENTER
	 (LAMBDA(X)
	  (PROG NIL
		(SETQ TEM (CDR (VLOC (QUOTE NEXT))))
		(RPLACD (CAR TEM) (CONS X (CDAR TEM)))
		(RETURN (RPLACA TEM (CDAR TEM)))))
 	 EXPR)

(DEFPROP PROPOSE
	 (LAMBDA(L)
	  (PROG NIL
		(SETQ L (CDR (VLOC (QUOTE NEXT))))
		(RETURN
		 (MAPC (QUOTE
			(LAMBDA(X)
			 (PROG NIL
			       (RPLACD (CAR L) (CONS X (CDAR L)))
			       (RETURN (RPLACA L (CDAR L))))))
		       (/, L)))))
 	 FEXPR)

(DEFPROP INSTANCE
	 (LAMBDA(L)
	  (PROG (NEXTF CALLA)
		(SETQ NEXTF (FR (VFRAME (QUOTE NEXT))))
		(SETQ CALLA (IVAL (QUOTE *CALLALIST) NEXTF))
		(SETQ L
		      (MATCH (IVAL (QUOTE *CALLPAT) NEXTF)
			     (IVAL (QUOTE *METHPAT) NEXTF)
 			     CALLA
			     (IVAL (QUOTE *METHALIST) NEXTF)))
		(COND
		 (L (RETURN (LIST (QUOTE *NOTE) (CPY (CAR L))))))))
 	 FEXPR)
(DEFPROP CPY
	 (LAMBDA(L)
	  (MAPCAR (QUOTE (LAMBDA (X) (LIST (CAR X) (CADR X)))) L))
 	 EXPR)

(DEFPROP GET-POSSIBILITIES
	 (LAMBDA NIL
	  (IVAL (QUOTE POSSIBILITIES)
		(CLINK (FR (VFRAME (QUOTE NEXT))))))
 	 FEXPR)

(DEFPROP SET-POSSIBILITIES
	 (LAMBDA(LIST)
	  (CSET (QUOTE POSSIBILITIES)
 		LIST
		(CONTROL (VFRAME (QUOTE NEXT)))))
 	 EXPR)

(CDEFUN GENERATE
	((QUOTE FORM))
        "AUX"
	((POSSIBILITIES
	  (LIST (LIST (QUOTE *POSSIBILITIES) FORM)
		(LIST (QUOTE *GENERATOR) FORM))))
	(GENGO)
	(: TRY-NEXT)
        POSSIBILITIES)